COMMENT ⊗   VALID 00022 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	TITLE MKCON - MAKE CONTOUR IMAGE - APRIL 1973 - B. G. BAUMGART.
C00005 00003	SUBR(MKCON)Q1,Q2.	MAKE: CONTOUR IMAGE FROM VIDEO.
C00007 00004	  SUBRS:		MAKE: MKIMAG(FILM). MKLEVL(IMAGE,CUT).
C00009 00005	  SUBRS:		MAKE: THRESH(CUT). PAXOR.
C00011 00006	SUBR(MKPGON)LEVEL	MAKE: POLYGON BY TRACING BIT RASTER BLOB.
C00013 00007				MAKE: MKPGON SUB-OPERATIONS.
C00014 00008				MAKE: THE ALCHEMIST OF MKPGON.
C00017 00009	SUBR(VICONT)LEVEL	CONTRAST: VECTOR INTENSITY CONTRAST.
C00020 00010				CONTRAST: VICONT CONTINUED.
C00023 00011	SUBR(ARCONT)LEVEL	CONTRAST: ARC CONTRAST.
C00025 00012	SUBR(MKSKY)LEVEL	NESTING: MAKE BORDER POLYGON & SKY ARRAY.
C00028 00013	  SUBRS:		NESTING: MKTREE,ATTACH,DETACH
C00031 00014	SUBR(INTREE)P1.		NESTING: PUT POLYGON INTO THE TREE.
C00033 00015				NESTING: INTREE CONTINUED.
C00035 00016	SUBR(INSKY)PGON		NESTING: PUT A POLYGON IN THE SKY ARRAY.
C00037 00017	SUBR(KILVIC)LEVEL.	KILL: CONTOURS OF THE PREVIOUS LEVEL.
C00038 00018	SUBR(KLBABY)LEVEL	KILL: BABY POLYGONS OF A LEVEL.
C00040 00019	SUBR(KLPGON)PGN		KILL: POLYGON AND RETURN CCW(PGN).
C00042 00020	SUBR(SMOOTH)LEVEL	SMOOTH: CONTOURS INTO ARCS.
C00044 00021	MKARCS(V1,V2).		SMOOTH: MAKE ARCS FROM V1 CCW TO V2.
C00047 00022	SUBR(HISTOG)		MISC: MAKE HISTOGRAM OF TVBUF.
C00048 ENDMK
C⊗;
TITLE MKCON - MAKE CONTOUR IMAGE - APRIL 1973 - B. G. BAUMGART.

	EXTERN PUTSKY,GETSKY
	EXTERN FLGHIS,ARCWID,CTRL,META
	EXTERN PAC,STADPY,TVBUF
	EXTERN HISTO,HSEG,VSEG,FILM
	EXTERN ROWPTR,COLPTR,DPYIMG
	EXTERN MKNODE,KLNODE,RINGIN
	EXTERN SQRT

	DECLARE{IMAGE,LEVEL,POLYGON}

;ENABLE SUBROUTINE FLAGS.
	INTERN ENEST,ECONT,ESMOO,ECOMP
	ENEST:-1	;POLYGON NESTING.
	ECONT:-1	;VECTOR AND ARC CONTRAST.
	ESMOO:-1	;MAKE ARC SMOOTHING.
	ECOMP:-1	;IMAGE COMPARING.
SUBR(MKCON)Q1,Q2.	MAKE: CONTOUR IMAGE FROM VIDEO.
BEGIN MKCON;---------------------------------------------------

;BIT POSITIONS OF THE ARGUMENTS Q1 & Q2 ENABLE INTENSITY CUTS.
	LAC 1,ARG2↔DAC 1,Q0
	LAC 1,ARG1↔ANDCMI 1,377↔DAC 1,Q1
	DZM CUT#

;MAKE THE IMAGE BLOCK AND THE LEVEL -1 FRAME POLYGON.
	SETQ IMAGE,{MKIMAG,FILM}
	SETQ LEVEL,{MKLEVL,IMAGE,[-1]}
	SETQ POLYGON,{MKSKY,LEVEL}	;BORDER & SKY.

;FIND AN INTENSITY CONTOUR ENABLE BIT.
L0:	LAC 0,Q0↔LAC 1,Q1
L1:	AOS 2,CUT↔LSHC 0,1↔JUMPL 0,L2
	CAMN 0,1↔JUMPE 0,L5↔GO L1

;THRESHOLD THE TVBUF
L2:	DAC 0,Q0↔DAC 1,Q1
	CALL(THRESH,CUT)
	CALL(PACXOR)

;MAKE LEVEL NODE WITH A RING OF POLYGON NODES.
	SETQ(LEVEL,{MKLEVL,IMAGE,CUT})
L3:	SETQ(POLYGON,{MKPGON,LEVEL})
	JUMPN 1,L3↔LAC 1,LEVEL↔SON 1,1↔JUMPE 1,L0

;LEVEL OPERATIONS.
L4:	CALL(VICONT,LEVEL)
	CALL(KLBABY,LEVEL)
	CALL(SMOOTH,LEVEL)
	CALL(ARCONT,LEVEL)
	CALL(MKTREE,LEVEL)
	CALL(KILVIC,LEVEL)
	CALL(STADPY)
	GO L0

;LAGGING LEVEL OPERATIONS.
L5:	LAC 1,LEVEL↔CCW 1,1↔DAC 1,LEVEL
	CALL(KILVIC,LEVEL)
	LAC 1,IMAGE↔POP2J

	DECLARE{Q0,Q1}
BEND MKCON; BGB 6 DECEMBER 1972 ----------------------------------
;  SUBRS:		MAKE: MKIMAG(FILM). MKLEVL(IMAGE,CUT).
SUBR(MKIMAG)FILM--------------------------------------------------
BEGIN MKIMAG; MAKE IMAGE NODE - BGB - 10 JANUARY 1973.
	EXTERN QIMAGE
	SETQ(IMAGE,{MKNODE,[IBIT+IMGREL]})
	CALL(RINGIN,IMAGE,FILM)
	LAC 1,IMAGE↔CW 2,1		;PREVIOUS IMAGE.
	NCNT 2,2↔AOS 2↔NCNT. 2,1	;IMAGE SEQUENCE NUMBER.
	DAC 1,QIMAGE
	LAC TVTIME↑↔DAC 3(1)
	POP1J
BEND;1/10/73------------------------------------------------------

SUBR(MKLEVL)IMAGE,CUT---------------------------------------------
BEGIN MKLEVL; MAKE LEVEL NODE - BGB - 10 JANUARY 1973.
	SETQ(LEVEL,{MKNODE,[LBIT+LVLREL]})
	CALL(RINGIN,LEVEL,IMAGE)
	LAC 1,LEVEL↔LAC 2,ARG2
	LAC 0,ARG1↔NCNT. 0,1
	POP2J
BEND;1/10/73------------------------------------------------------
;  SUBRS:		MAKE: THRESH(CUT). PAXOR.
SUBR(THRESH)------------------------------------------------------
BEGIN THRESH
;SOUTH TO PAC FOR PIXELS ≥ CUT.
	I←13 ↔ J←14
	LAC [XWD L,2]↔BLT 13
	LAP 5,ARG1
	GO 3

;ACCUMULATOR LOOP.
L:	POINT 6,TVBUF,-1
	MOVEI J,=36	;3
	ILDB 2		;4
	SUBI ;CUT	;5
	ROTC 1		;6
	SOJG J,4	;7
	SETCAM 1,PAC(I) ;10
	AOBJN I,3	;11
	POP1J		;12
	XWD -=1728,0	;13
BEND THRESH;BGB 4 DECEMBER 1972 ----------------------------------


;PACXOR.		ROOK'S MOVE XOR'ING ON 1-BIT IMAGE.
SUBR(PACXOR)------------------------------------------------------
BEGIN PACXOR
	I←2
	SLACI PAC↔LAPI HSEG↔BLT HSEG+=1727
	SLACI PAC↔LAPI VSEG↔BLT VSEG+=1727
	SETZ I,
	HRRI PAC↔DAP L+2
L:	TRNN I,7↔SETZ 1,↔LAC PAC(I)
	XORM HSEG+8(I)		;HSEG's are above PAC bits.
	ROTC -1↔ROT 1,1
	XORM VSEG(I)		;VSEG's are left of PAC bits.
	AOS I
	CAIE I,=1728
	GO L
	POP0J
BEND PACXOR; BGB 4 DECEMBER 1972 ---------------------------------
SUBR(MKPGON)LEVEL	MAKE: POLYGON BY TRACING BIT RASTER BLOB.
BEGIN MKPGON;------------------------------------------------------

	ACCUMULATORS{A2,A3,RC.,MASK,I,PTR,D,E,V,PG,BITQ,H1,H2}
	LAC 1,ARG1↔NCNT H1,1↔LSH H1,-3
	LACI H2,7↔SUB H2,H1
	LAC I,ISAVED#↔CDR PTR,ARG1↔LACI BITQ,VREL
	SLACI I↔HRRI PAC↔DAC PACPTR#; PAC POINTER INDEXED BY I.

;FIND THE ROW & COL OF THE UPPER LEFT MOST VSEG.
L1:	SKIPE 1,VSEG(I)↔GO L2
	AOS I↔CAIE I,=1728↔GO L1
	SETZB 1,ISAVED#↔POP1J		;PAC IS NOW EMPTY.

L2:	DAC I,ISAVED↔JFFO 1,.+1↔SLACI MASK,400000
	MOVNS 2↔LSH MASK,(2)↔MOVNS 2
	LAC RC.,I↔ANDI RC.,7↔IMULI RC.,=36↔ADD RC.,2	;COLUMN.
	LAC I↔LSH -3↔DIP RC.↔LSH RC.,6			;ROW.

;DISTINGUISH BLOBS FROM HOLES.
	DZM HOLE#
	TDNN MASK,@PACPTR		;HOLE OR BLOB ?
	SETOM HOLE#			;HOLE'A'COMING.
	SKIPE HOLE↔EXCH H1,H2

;AND HEAD SOUTH.

	SETQ(PG,{MKNODE,[PBIT+PGNREL]})
	LAC 0,ARG1↔DAD. 0,PG↔CALL(RINGIN,PG,0)
	SKIPE HOLE↔GO[MARK PG,HOLBIT↔GO .+1]
	DAC  RC.,RCMIN#
	DZM RCMAX#
	SETZ V,↔DZM ECNT#
	PUSHJ P,FOLLOW
	LAC V,V0
	CCW. V,E↔CW. E,V

;MAKE & RETURN VIC POLYGON.

	LAC 1,ECNT↔SKIPE HOLE#↔MOVNS 1
 	NCNT. 1,PG
	LAC V0↔SON. 0,PG	;UPPER MOST LEFT.
	LAC V1↔ARC. 0,PG	;LOWER MOST RIGHT.
	LAC 1,PG
L3:	POP1J
;			MAKE: MKPGON SUB-OPERATIONS.

DEFINE	TRY (SEG,YES) {
	LAC SEG(I)↔TDZN MASK↔GO .+3↔DAC SEG(I)↔GO YES}
DEFINE	LEFT	{SUBI RC.,100↔ROT MASK,1↔CAIN MASK,1↔SOS I}
DEFINE	RIGHT	{ADDI RC.,100↔ROT MASK,-1↔SKIPG MASK↔AOS I}
DEFINE	UP 	{SUB RC.,[1B11]↔SUBI I,8}
DEFINE	DOWN  	{ADD RC.,[1B11]↔ADDI I,8}

;CREATE NEW EDGE AND VERTEX OF A VIC.
TURN:	0
	AOS TURNS#
	ADD D,RC.
	AOS 2,ECNT

;VERTEX
	CALL(MKNODE,BITQ)
	DAD. PG,1
	SKIPN V↔GO[DAC 1,V0#↔DAC 1,V↔GO T2]
	DAC 1,V
	CCW. V,E↔CW. E,V
T2:	DAC D,RC(V)
	CAMLE D,RCMAX
	GO[DAC D,RCMAX↔DAC V,V1#↔GO .+1]
	DAC V,E
	GO @TURN
;			MAKE: THE ALCHEMIST OF MKPGON.
	;converts bits of lead into lines of gold.

NORTH:	ADD D,[1B11]↔LIPI BITQ,(NORBIT+VBIT)↔JSR TURN
NORTH2:	LEFT↔LAC D,DELPM(H1)↔TRY HSEG,WEST
	RIGHT↔UP↔TRY VSEG,NORTH2
	DOWN↔LAC D,DELPP(H2)↔TRY HSEG,EAST↔FATAL(NORTH)
NORTH3:	LIPI BITQ,(NORBIT+VBIT)↔JSR TURN↔LEFT
NORTH4:	UP↔LAC D,DELPM(H1)↔TRY HSEG,WEST↔GO NORTH4


WEST:	ADDI D,100↔LIPI BITQ,(WESBIT+VBIT)↔JSR TURN
WEST2:	CAMN RC.,RCMIN↔POPJ P,
FOLLOW:	LAC D,DELPP(H1)↔TRY VSEG,SOUTH
	LEFT↔TRY HSEG,WEST2
	RIGHT↔UP↔LAC D,DELMP(H2)↔TRY VSEG,NORTH↔FATAL(WEST)


SOUTH:	LIPI BITQ,(SOUBIT+VBIT)↔JSR TURN
SOUTH2:	DOWN↔LAC D,DELMP(H1)
	CAR RC.↔CAIN =216B29↔GO EAST3
	TRY HSEG, EAST↔TRY VSEG,SOUTH2
	LEFT↔LAC D,DELMM(H2)↔TRY HSEG,WEST↔FATAL(SOUTH)


EAST:	LIPI BITQ,(EASBIT+VBIT)↔JSR TURN
EAST2:	RIGHT↔LAC D,DELMM(H1)
	CDR RC.↔CAIN =288B29↔GO NORTH3
	UP↔TRY VSEG,NORTH
	DOWN↔TRY HSEG,EAST2
	LAC D,DELPM(H2)↔TRY VSEG,SOUTH↔FATAL(EAST)
EAST3:	LIPI BITQ,(EASBIT+VBIT)↔JSR TURN↔UP
EAST4:	RIGHT↔LAC D,DELMM(H1)
	CDR RC.↔CAIN =288B29↔GO[DOWN↔GO NORTH3]
	TRY VSEG,NORTH↔GO EAST4

;DEKINKING OFF SETS.

	DELPP:	FOR I←24,33{XWD I,I↔}
	DELPM:	FOR I←24,33{XWD I,-I↔}
	DELMP:	FOR I←24,33{XWD -I,I↔}
	DELMM:	FOR I←24,33{XWD -I,-I↔}


BEND MKPGON;BGB AUGUST 1972 ---------------------------------------
SUBR(VICONT)LEVEL	CONTRAST: VECTOR INTENSITY CONTRAST.
COMMENT ⊗
The contrast of a vector is defined  as (QUOTIENT (DIFFERENCE (Sum of
pixel values  on one side of the vector) (Sum  of pixel values on the
other side of the vector)) (length of the vector in  pixels)). Since,
vectors  are always  either  horizontal or  vertical,  there are  two
inner  most  loops.  For horizontal  vectors  two  byte  pointers are
incremented up core west to east a row apart thru  the TVBUF. For the
vertical vectors  one byte pointer is saved  then LDB'ed and ILDB'ed,
and then is restored and bumped a row by the code at line NSL:
⊗;

BEGIN VICONT;--------------------------------------------------------
	ACCUMULATORS{R1,C1,V1,R2,C2,V2,PG,SUM1,SUM2,CNT,PTR,SAVCNT}
	SKIPN ECONT↔POP1J
	LAC 1,ARG1↔SON PG,1↔DAC PG,PG0#		;FIRST POLYGON.
L1:	SON V2,PG↔DAC V2,V0#			;FIRST VECTOR.
	ROW R2,V2↔ADDI R2,40↔LSH R2,-6
	COL C2,V2↔ADDI C2,40↔LSH C2,-6

L2:	LAC V1,V2↔LAC R1,R2↔LAC C1,C2↔CCW V2,V2	;NEXT VECTOR.
	ROW R2,V2↔ADDI R2,40↔LSH R2,-6
	COL C2,V2↔ADDI C2,40↔LSH C2,-6
	SETZB SUM1,SUM2
	TESTZ V1,WESBIT↔GO WEST
	TESTZ V1,SOUBIT↔GO SOUTH
	TESTZ V1,EASBIT↔GO EAST
	TESTZ V1,NORBIT↔GO NORTH↔HALT
L3:	CAME V2,V0↔GO L2↔CCW PG,PG	;NEXT POLYGON.
	CAME PG,PG0↔GO L1↔POP1J		;EXIT.
;-----------------------------------------------------------------
;			CONTRAST: VICONT CONTINUED.
WEST:	LAC ROWPTR(R2)↔ADD COLPTR-1(C2)↔TLZ 1
	LAC CNT,C1↔SUB CNT,C2↔CALL(EW)		;CNT ← C1-C2
	SUB SUM2,SUM1
	NTIME. SUM2,V1↔PTIME. SAVCNT,V1
	IDIV SUM2,SAVCNT
	CNTRS. SUM2,V1↔GO L3
SOUTH:	LAC ROWPTR(R1)↔ADD COLPTR-1(C1)↔TLZ 1
	LAC CNT,R2↔SUB CNT,R1↔CALL(NS)		;CNT ← R2-R1
	SUB SUM2,SUM1
	NTIME. SUM2,V1↔PTIME. SAVCNT,V1
	IDIV SUM2,SAVCNT
	CNTRS. SUM2,V1↔GO L3
EAST: 	LAC ROWPTR(R1)↔ADD COLPTR-1(C1)↔TLZ 1
	LAC CNT,C2↔SUB CNT,C1↔CALL(EW)		;CNT ← C2-C1
	SUB SUM1,SUM2
	NTIME. SUM1,V1↔PTIME. SAVCNT,V1
	IDIV SUM1,SAVCNT
	CNTRS. SUM1,V1↔GO L3
NORTH:	LAC ROWPTR(R2)↔ADD COLPTR-1(C2)↔TLZ 1
	LAC CNT,R1↔SUB CNT,R2↔CALL(NS)		;CNT ← R1-R2
	SUB SUM1,SUM2
	NTIME. SUM1,V1↔PTIME. SAVCNT,V1
	IDIV SUM1,SAVCNT
	CNTRS. SUM1,V1↔GO L3
	DECLARE{PTRNW,PTRSE}
;-----------------------------------------------------------------
;EAST-WEST HORIZONAL VECTORS.
EW:	DAC CNT,SAVCNT
	DAC PTRSE
	SUBI =48↔DAC PTRNW
EWL:	ILDB PTRNW↔ADDM SUM1
	ILDB PTRSE↔ADDM SUM2
	SOJG CNT,EWL

	CAIG R1,0↔SETZ SUM1,
	CAIL R1,=216↔SETZ SUM2,
	POP0J

;NORTH-SOUTH VERTICAL VECTORS.
NS:	DAC CNT,SAVCNT↔DAC PTR↔TDCA 1,1

NSL:	LACI 1,=48↔ADDB 1,PTR
	 LDB 1↔ADDM SUM1
	ILDB 1↔ADDM SUM2
	SOJG CNT,NSL
	CAIG  C1,0↔SETZ SUM1,
	CAIL  C1,=288↔SETZ SUM2,↔POP0J
BEND VICONT; BGB 14 DECEMBER 1972 --------------------------------
SUBR(ARCONT)LEVEL	CONTRAST: ARC CONTRAST.
BEGIN ARCONT;-----------------------------------------------------
	ACCUMULATORS{QNS,QEW,A1,A2,V1,V2,PG,PG0,A0,NS,EW}
	SKIPN ECONT↔POP1J↔SKIPN ESMOO↔POP1J
;FOR ALL THE ARCS OF THIS LEVEL.
	LAC 1,ARG1
	SON PG,1↔DAC PG,PG0	;FIRST POLYGON.
L1:	ARC A2,PG↔DAC A2,A0	;FIRST ARC.
L2:	LAC A1,A2↔SON V1,A1
	CCW A2,A1↔SON V2,A2

;ACCUMULATE VECTOR CONTRAST,,LENGTH ALONG THE ARC.
	SETZB QNS,QEW
	SETZB NS,EW
L3:	TESTZ V1,NORBIT+SOUBIT↔GO[
	NIP 6(V1)↔ADDM QNS
	NAP 6(V1)↔ADDM  NS↔GO .+5]
	NIP 6(V1)↔ADDM QEW
	NAP 6(V1)↔ADDM  EW
	DZM 6(V1)↔↔CCW V1,V1
	CAME V1,V2↔GO L3

;COMPUTE ARC CONTRAST:  SIN*VERTICAL + COS*HORIZONTAL.
L5:	FSC NS,233↔FSC QNS,233↔FDVR QNS,NS
	HLLZ 1,6(A1)↔FMPR QNS,1

	FSC EW,233↔FSC QEW,233↔FDVR QEW,EW
	HRLZ 1,6(A1)↔FMPR 1,QEW↔FADR 1,QNS

	FIX 1,233000↔CNTRS. 1,A1↔DZM 6(A1)

	CAME A2,A0↔GO L2	;LAST ARC OF THE POLYGON ?
	CCW PG,PG
	CAME PG,PG0↔GO L1	;LAST POLYGON OF THE LEVEL ?
	POP1J
BEND ARCONT; 21 JANUARY 1973 -------------------------------------
SUBR(MKSKY)LEVEL	NESTING: MAKE BORDER POLYGON & SKY ARRAY.
BEGIN MKSKY;------------------------------------------------------

	ACCUMULATORS{R,C,N,S,E,W,M,LVL}

;MAIN BORDER POLYGON.
	SETQ(M,{MKNODE,[PBIT+PGNREL]})
	LAC LVL,ARG1↔DAD. LVL,1
	CALL(RINGIN,M,LVL)
	LACI R,=216⊗6↔LACI C,=288⊗6

;VERTEX-POLYGON POLYGON.
	SETQ(W,{MKNODE,[VBIT+SOUBIT+VREL]})↔DAD. M,W
	SETQ(S,{MKNODE,[VBIT+EASBIT+VREL]})↔DAD. M,S
	SETQ(E,{MKNODE,[VBIT+NORBIT+VREL]})↔DAD. M,E
	SETQ(N,{MKNODE,[VBIT+WESBIT+VREL]})↔DAD. M,N
	ROW. R,S↔ROW. R,E↔COL. C,E↔COL. C,N
	CW.  N,W ↔ CW.  E,N ↔ CW.  S,E ↔ CW.  W,S
	CCW. S,W ↔ CCW. E,S ↔ CCW. N,E ↔ CCW. W,N
	SON. W,M↔LAC 1,M


;PUT THE BORDER POLYGON UP IN THE SKY.
	CDR GETSKY↔DZM@↔DIP↔AOS
	CDR 1,GETSKY↔BLT =31500-1(1)
	SETZ C,↔LACI R,=216↔LAC W
	XCT PUTSKY(R)↔SOJGE R,.-1
	LACI R,=216↔LACI C,=288↔LAC E
	XCT PUTSKY(R)↔SOJGE R,.-1

;ARC BORDER POLYGON.
	LACI R,=216⊗6↔LACI C,=288⊗6
	CALL(MKNODE,[ARCBIT+VBIT+VREL])↔SON. 1,W↔SON. W,1↔LAC W,1
	CALL(MKNODE,[ARCBIT+VBIT+VREL])↔SON. 1,S↔SON. S,1↔LAC S,1
	CALL(MKNODE,[ARCBIT+VBIT+VREL])↔SON. 1,E↔SON. E,1↔LAC E,1
	CALL(MKNODE,[ARCBIT+VBIT+VREL])↔SON. 1,N↔SON. N,1↔LAC N,1
	ROW. R,S↔ROW. R,E↔COL. C,E↔COL. C,N
	DAD. M,W↔DAD. M,S↔DAD. M,E↔DAD. M,N
	CW.  N,W ↔ CW.  E,N ↔ CW.  S,E ↔ CW.  W,S
	CCW. S,W ↔ CCW. E,S ↔ CCW. N,E ↔ CCW. W,N
	ARC. W,M↔LAC 1,M↔POP1J
BEND MKSKY; BGB 4 DECEMBER 1972 ----------------------------------
;  SUBRS:		NESTING: MKTREE,ATTACH,DETACH;
SUBR(MKTREE)LEVEL
BEGIN MKTREE;---------------------------------------------------
	SKIPN ENEST↔POP1J
;PLACE POLYGONS OF THIS LEVEL IN THE TREE AND IN THE SKY.
	LAC 1,ARG1↔SON 1,1↔DAC 1,PG0#↔DAC 1,POLYGON
L1:	CALL(INTREE,POLYGON)
	LAC 1,POLYGON
	CCW 1,1
	DAC 1,POLYGON
	CAME 1,PG0↔GO L1
	POP1J
BEND MKTREE; BGB 19 DECEMBER 1972 --------------------------------

SUBR(ATTACH)P1,P2-----------------------------------------------
BEGIN ATTACH;PLACE P1 WITHIN P2 - BGB - 23 JANUARY 1973.
	LAC 1,ARG2↔LAC 2,ARG1
	EXO. 2,1↔ENDO 3,2	;EXO(P1)←P2;P3←ENDO(P);
	JUMPN 3,.+5		;IF P3=0 THEN BEGIN
	ENDO. 1,2↔PGON. 1,1	;ENDO(P2)←NGON(P1)←PGON(P1)←P1;
	NGON. 1,1↔POP2J		;RETURN;END;
	NGON 4,3		;P4←NGON(P3);
	PGON. 1,4↔NGON. 1,3	;PGON(P4)←NGON(P3)←P1;
	NGON. 4,1↔PGON. 3,1	;NGON(P1)←P4;PGON(P1)←P3;
	POP2J
BEND;1/23/73------------------------------------------------------

SUBR(DETACH)P1--------------------------------------------------
BEGIN DETACH;REMOVE P1 FROM THE TREE - BGB - 23 JANUARY 1973.
	LAC 1,ARG1
	NGON 2,1↔PGON 3,1	;P2←NGON(P1);P3←PGON(P1);
	PGON. 3,2↔NGON. 2,3	;PGON(P2)←P3;NGON(P3)←P2;
	NGON. 1,1↔PGON. 1,1	;NGON(P1)←PGON(P1)←P1;
	CAMN 3,1↔SETZ 3,	;IF P3=P1 THEN P3←NIL;
	EXO 2,1↔ENDO 0,2	;P2←EXO(P1);P0←ENDO(P2);
	CAMN 0,1↔ENDO. 3,2	;IF P0=P1 THEN ENDO(P2)←P3;
	POP1J
BEND;1/23/73------------------------------------------------------
SUBR(INTREE)P1.		NESTING: PUT POLYGON INTO THE TREE.
BEGIN INTREE;-----------------------------------------------------

	ACCUMULATORS{R,C,E,LST,P0,P1,P2,P3}
	LAC P1,ARG1
	SON E,P1↔JUMPE E,POP1J.
	ROW R,(E)↔ADDI R,40↔LSH R,-6
	COL C,(E)↔ADDI C,40↔LSH C,-6
	TESTZ P1,HOLBIT↔SOS C

;FIND THE VERTICAL EDGE DUE EAST OF HERE.
L0:	XCT GETSKY(R)↔SKIPN 1↔SOJA C,L0
	ANDCMI 1,%↔DAD P2,1↔CAMN P2,P1↔SOJA C,L0

;PLACE P1 WITHIN P2, IN THE TREE AND IN THE SKY.
	TEST  1,SOUBIT↔EXO P2,P2
	CALL(ATTACH,P1,P2)
	CALL(INSKY,P1)

;CONS UP LIST OF P2'S ENDO POLYGONS.
	LAC P1,ARG1↔HRLOI LST,0			;LIST ← NIL.
	EXO P2,P1↔ENDO P3,P2↔JUMPE P3,POP1J.	;AIN'T NONE.
	DAC P3,P0
L1:	CAMN P3,P1↔GO L2
	PTIME. LST,P3↔LAC LST,P3		;CONS P3 TO LIST.
L2:	NGON P3,P3↔CAME P3,P0↔GO L1		;CDR THE RING.

;			NESTING: INTREE CONTINUED.
;SCAN LIST FOR P1 ENDO POLYGONS. P2←CDR(LIST).
L3:	CAIN LST,-1↔SETZ LST,
	SKIPN P2,LST↔POP1J↔SON E,P2
	ROW R,E↔ADDI R,40↔LSH R,-6
	COL C,E↔ADDI C,40↔LSH C,-6

;SCAN FOR FIRST POLYGON TO THE EAST OF P2.
L4:	JUMPL C,L7
	XCT GETSKY(R)↔SKIPN 1↔SOJA C,L4
	TRNE 1,%↔GO[TRC 1,%
	DAD P3,1↔CAMN P3,LST↔GO L7↔GO .+4]
	DAD P3,1↔CAMN P3,LST↔SOJA C,L4
	TESTZ 1,SOUBIT↔GO L5			;SKIP ON BRO. GO ON DAD.

;IF BROTHER IS NOT ON THE P-LIST THEN EXO(P3) IS VALID.
L4A:	LAC P0,P3↔EXO P3,P3
	PTIME 0,P0↔JUMPE 0,L5
;IF BROTHER IS ON P-LIST THEN EXO(P3) IS NOT YET VALID AND MUST
;BE SAVED ON AN N-LIST.
	NTIME 0,P0↔NTIME. 0,P2
	NTIME. P2,P0↔GO L6

;CHECK FOR P1 CAPTURE OF P2. P3 IS THE SKY-EXO(P2).
L5:	EXO 0,P2
	CAMN 0,P3↔GO L6		;EXO(P2)=SKYEXO(P2).
	CALL(DETACH,P2)
	CALL(ATTACH,P2,P1)

;CAPTURE OLDER BROTHER OFF THE N-LIST OF P2.
L6:	LAC 1,P2↔SETZ
	NTIME P2,P2
	NTIME. 0,1
	JUMPN P2,L5

;CDR THE P-LIST OF POTENTIAL ENDO POLYGONS.
L7:	LAC 1,LST↔SETZ
	PTIME LST,LST↔PTIME. 0,1
	GO L3
BEND INTREE; BGB 23 JANUARY 1973 ---------------------------------
SUBR(INSKY)PGON		NESTING: PUT A POLYGON IN THE SKY ARRAY.
BEGIN INSKY;------------------------------------------------------

	ACCUMULATORS{R,C,R2,C2,E,E2}

DEFINE ADVANCE{
	LAC E,E2↔LAC R,R2↔LAC C,C2
	CCW E2,E2
	ROW R2,E2↔ADDI R2,40↔LSH R2,-6
	COL C2,E2↔ADDI C2,40↔LSH C2,-6}

;XWD HORIZONTAL,,VERTICAL.
	LAC 1,ARG1↔SON E,1
	DAC E,E0#↔JUMPE E,POP1J.
	CW E2,E↔ADVANCE↔ADVANCE↔GO S1

;SOUTH ↓ BOUND.
S0:	CAMN E,E0↔POP1J
S1:	LAC E↔XCT GETSKY(R)
	SKIPE 1↔TRC %↔XCT PUTSKY(R)
	CAIE R2,(R)1↔AOJA R,S1↔ADVANCE
	TEST E,EASBIT↔GO W0↔GO EE0

;NORTH ↑ BOUND.
N0:	SOS R
N1:	LAC E↔XCT GETSKY(R)
	SKIPE 1↔TRC %↔XCT PUTSKY(R)
	CAME R,R2↔SOJA R,N1↔ADVANCE
	TEST E,EASBIT↔GO W0↔GO EE0

;EAST → BOUND.
EE0:	ADVANCE
	TEST E,NORBIT↔GO S0↔GO N0

;WEST ← BOUND.
W0:	ADVANCE
	TEST E,NORBIT↔GO S0↔GO N0

BEND INSKY;BGB 7 DECEMBER 1972 -----------------------------------
SUBR(KILVIC)LEVEL.	KILL: CONTOURS OF THE PREVIOUS LEVEL.
BEGIN KILVIC;-----------------------------------------------------
	ACCUMULATORS{PG,E0,E1,E2,PG0}
	SKIPN ESMOO↔POP1J
	LAC 1,ARG1↔CW 1,1
	SON PG,1
	SKIPN PG0,PG↔POP1J

;RELEASE VIC NODES OF THE POLYGON.
L1:	SON E0,PG
	TESTZ E0,ARCBIT↔GO L3
	ARC 0,PG↔SON. 0,PG
	SETZ↔ARC. 0,PG
	LAC  E1,E0
L2:	CCW  E2,E1
	SETZ↔SON 1,E1↔SKIPE 1↔SON. 0,1
	CALL(KLNODE,E1)
	CAMN E2,E0↔GO L3
	LAC  E1,E2↔GO L2

;ADVANCE TO NEXT POLYGON ON THIS LEVEL.
L3:	CCW PG,PG
	CAME PG,PG0↔GO L1
	POP1J

BEND KILVIC; BGB 5 JANUARY 1973 ----------------------------------
SUBR(KLBABY)LEVEL	KILL: BABY POLYGONS OF A LEVEL.
BEGIN KLBABY;-----------------------------------------------------
	ACCUMULATORS{A,PG,E0,E1,E2,Q,R}
	LAC 1,ARG1↔SON PG,1↔DAC PG,PG0#
;KLUDGE - SPARE SON POLYGON UNTIL WE CAN THINK OF A POLICY.
	GO L3

;ELIMINATE INSIGNIFICANT CONTOURS - SMALL LOW CONTRAST.
L1:	NCNT 0,PG↔LACM
	CAIL =10↔GO L3

;RELEASE VIC NODES OF THE POLYGON.
	SON E0,PG
	LAC  E1,E0
L2:	CCW  E2,E1
	CALL(KLNODE,E1)
	CAMN E2,E0↔GO .+3
	LAC  E1,E2↔GO L2

;KILL A BABY POLYGON.
	CAR Q,(PG)↔CDR R,(PG)
	DIP Q,(R)↔ DAP R,(Q)	;RINGO PG.
	CALL(KLNODE,PG)
	SKIPA PG,R		;CCW FROM OUT OF THE GRAVE.

;ADVANCE TO NEXT POLYGON ON THIS LEVEL.
L3:	CCW PG,PG↔CAME PG,PG0↔GO L1
	POP1J

BEND;1/6/73------------------------------------------------------
SUBR(KLPGON)PGN		KILL: POLYGON AND RETURN CCW(PGN).
BEGIN KLPGON;-----------------------------------------------------
	ACCUMULATORS{PG,E0,E1,E2,Q,R}
	LAC PG,ARG1

;RELEASE VIC NODES OF THE POLYGON.

	SON E0,PG
	LAC  E1,E0
L1:	CCW  E2,E1
	CALL(KLNODE,E1)
	CAMN E2,E0↔GO .+3
	LAC  E1,E2↔GO L1

;RING OUT & KILL POLYGON NODE,

	NGON Q,PG↔PGON R,PG↔JUMPE R,L2
	NGON. Q,R↔PGON. R,Q↔CAMN PG,R↔SETZ R,
	EXO 1,PG↔JUMPE 1,.+4↔ENDO 0,1↔CAMN 0,PG↔ENDO. R,1
	ENDO 1,PG↔SKIPE 1↔ZIP 3(1) ;MY ENDO BECOMES AN ORPHAN.

L2:	CAR Q,(PG)↔CDR R,(PG)
	DIP Q,(R)↔ DAP R,(Q)	;RINGO PG.
	CALL(KLNODE,PG)

;DOES DAD NEED A NEW FIRST SON.

	DAD 1,R
	CAMN PG,R↔SETZ R,
	SON 0,1↔CAMN 0,PG↔SON. R,1

;RETURN PGON CCW FROM OUT OF THE GRAVE.
	LAC 1,R
	POP1J

BEND KLPGON;BGB 1 JANUARY 1973 ----------------------------------
SUBR(SMOOTH)LEVEL	SMOOTH: CONTOURS INTO ARCS.
BEGIN SMOOTH;-----------------------------------------------------

	ACCUMULATORS{V1,V2,PG,E0,E1,E2}
	SKIPN ESMOO↔POP1J
	LAC 1,ARG1
	SON PG,1↔SKIPN PG↔POP1J

;POLYGON INITIALIZATION.

L1:	DAC PG,PGSAVE#
	SON V1,PG↔DAC V1,E0SAVE#   ;UPPER MOST LEFT VERTEX.
	ARC V2,PG		   ;LOWER MOST RIGHT VERTEX.
	TESTZ V2,ARCBIT↔POP1J	   ;END OF LEVEL'S POLYGON RING.

;CREATE ARC NODES AT POLYGON'S EXTREME CORNERS.

	SETQ(ARC2,{MKNODE,[VBIT+ARCBIT+VREL]})
	LAC RC(V2)↔DAC RC(1)↔SON. 1,V2↔SON. V2,1
	SETQ(ARC1,{MKNODE,[VBIT+ARCBIT+VREL]})
	LAC RC(V1)↔DAC RC(1)↔SON. 1,V1↔SON. V1,1

	LAC 2,ARC2↔CCW. 1,2↔CW. 1,2↔CCW. 2,1↔CW. 2,1
	DAD. PG,1↔DAD. PG,2↔ARC. 1,PG

;CALL FOR CREATION OF THE INTERMEDIATE ARC NODES.
	DZM AVCNT
	CALL(MKARCS,ARC1,ARC2)
	CALL(MKARCS,ARC2,ARC1)

;KILL TWO-SIDED ARC-POLYGONS AND ADVANCE TO NEXT POLYGON.
	SKIPN AVCNT↔GO[
L2:		CALL(KLNODE,ARC1)
		CALL(KLNODE,ARC2)
		SETQ(PG,{KLPGON,PGSAVE})
		JUMPN PG,L1↔POP1J]
	LAC PG,PGSAVE↔CCW PG,PG↔GO L1

	LIT
	DECLARE{ARC1,ARC2}
BEND SMOOTH; BGB 6 DECEMBER 1972 ---------------------------------

	DECLARE{AVCNT}	;ARC-VERTEX COUNT.
;MKARCS(V1,V2).		SMOOTH: MAKE ARCS FROM V1 CCW TO V2.
SUBR(MKARCS)V1,V2-------------------------------------------------
BEGIN MKARCS
	ACCUMULATORS{D,U1,U2,V1,V2,A,B,C,U,V}
	LAC V1,ARG2↔LAC V2,ARG1
;CHECK FOR TRIVAIL CASE.
L0:	SON U1,V1↔SON U2,V2

;COMPUTE NORMALIZED ARC EDGE COEFFICIENTS.
	ROW A,V1↔FLO A,		; A ← Y1.
	COL B,V2↔FLO B,		; B ← X2.
	COL C,V1↔FLO C,		; C ← X1.
	ROW D,V2↔FLO D,		; D ← Y2.
	LAC 1,B↔FMPR 1,A	; 1 ← X2*Y1.
	FSBR A,D↔FSBR B,C	; A ← Y1-Y2.   B ← X2-X1.
	FMPR C,D↔FSBR C,1	; C ← X1*Y2 - X2*Y1.
	LAC 0,A↔FMPR 0,0↔LAC 1,B↔FMPR 1,1↔FADR 1,0
	CALL SQRT,1↔FDVR A,1↔FDVR B,1↔FDVR C,1
	LACM 0,A↔HLLM 0,6(V1)
	LACM 0,B↔HLRM 0,6(V1)

;SET 'EM UP FOR AN ARC PASS.
	SON U1,V1↔SON U2,V2
	CCW 0,U1↔CAMN 0,U2↔GO L3
	DZM DMAX#↔DZM DMIN#
	DZM VMAX#↔DZM VMIN#↔DZM MAXCON#
;GO FROM U1 CCW TO U2 AND FIND THE U FURTHEST OFF THE ARC-EDGE.
L1:	CCW U1,U1↔CAMN U1,U2↔GO L2
	COL 0,U1↔FLO 0,↔ROW 1,U1↔FLO 1,
	FMPR 0,A↔FMPR 1,B↔LAC D,C↔FADR D,0↔FADR D,1
	CAMGE D,DMIN↔GO [DAC U1,VMIN↔DAC D,DMIN↔GO .+1]
	CAMLE D,DMAX↔GO [DAC U1,VMAX↔DAC D,DMAX↔GO .+1]
;KEEP TRACK OF MAXIMUM EDGE CONTRAST ALONG ARC.
	CNTRST 0,V1↔MOVM↔CAMLE MAXCON↔DAC MAXCON↔GO L1

;WHEN EXTREMA EXCEED ARCWID[MAXCON] THEN FORM ARC-POINTS.
L2:	LAC U,VMIN↔LACM DMIN
	CAMGE DMAX↔LAC U,VMAX
	CAMGE DMAX↔LAC DMAX
	LAC 1,MAXCON↔CAMGE ARCWID(1)↔GO L3
;OLDE ESPLIT.
	SETQ(V,{MKNODE,[VBIT+ARCBIT+VREL]})↔AOS AVCNT
	SON. U,V↔SON. V,U
	LAC RC(U)↔DAC RC(V)↔DAD 0,U↔DAD. 0,V
	CCW. V,V1↔CW. V1,V
	CCW. V2,V↔CW. V,V2
	LAC V2,V↔GO L0
;ADVANCE CCW AN ARC-EDGE OR EXIT.
L3:	CAMN V2,ARG1↔POP2J
	LAC V1,V2↔CCW V2,V2↔GO L0
BEND MKARCS; BGB 28 DECEMBER 1972 --------------------------------
SUBR(HISTOG)		MISC: MAKE HISTOGRAM OF TVBUF.
BEGIN HISTOG;--------------------------------------------------
	SKIPE FLGHIS↔POP0J↔SETOM FLGHIS
	LAC[XWD HISTO,HISTO+1]
	DZM HISTO↔BLT HISTO+77
	LAC 7,[XWD L,0]↔BLT 7,6↔GO 2

;ACCUMULATOR LOOP.
L:	=62208		;0
	0		;1
	ILDB 1,6	;2
	AOS HISTO(1)	;3
	SOJG 0,2	;4
	POP0J		;5
	POINT 6,TVBUF,-1;6

BEND HISTOG; BGB 4 DECEMBER 1972 ---------------------------------
END